home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / MCQUAY1 / SHADOW.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-15  |  3KB  |  111 lines
  1. Unit shadow;
  2. { Provides basic routines needed to implement Shadow Classes }
  3. interface
  4.     function  ValidVMT(VMT:pointer):boolean;
  5.     function  FindMethodSlot (AMethod:pointer; ClassVMT:pointer):pointer;
  6.     function  ReplaceMethod (ClassVMT,OldMethod,NewMethod:pointer):boolean;
  7.  
  8.  { Basic VMT structure }
  9.     const
  10.         MaxVMTPointers = 192;
  11.     type
  12.         PMethodTable = ^TMethodTable;
  13.         TMethodTable = array[0..MaxVMTPointers] of pointer;
  14.  
  15.         PVMT = ^TVMT;
  16.         TVMT = record
  17.             Size:word; NegSize:integer;
  18.         {$IFDEF VER70}
  19.             DMTofs:word;    {Dynamic Method Table Offset into DS}
  20.             Reserved:word;
  21.         {$ENDIF}
  22.             Table:TMethodTable;
  23.             end;
  24.  
  25.         PDMT = ^TDMT;
  26.         TDMT = record
  27.             BaseDMT:word;
  28.             Cache:record
  29.                 Index,Entry:word;
  30.                 end;
  31.             Cnt:word;
  32.             end;
  33.  
  34. implementation
  35. {===============================================}
  36.     function ValidVMT(VMT:pointer):boolean;
  37.      { Checks to see if VMT is a pointer to a valid Virtual
  38.          Method Table. This is not foolproof, but is all TP has
  39.          provided for such a check.  This is the same check used
  40.          by runtime system with range checking.                   }
  41.         begin
  42.         ValidVMT := ((PVMT(VMT)^.size<>0) and
  43.                                  ((PVMT(VMT)^.Size + PVMT(VMT)^.NegSize)=0)) ;
  44.         end;
  45.  {------------------------------------------------------}
  46.  {$IFDEF VER70}
  47.     {Find a Method in a Dynamic Method Table (DMT).  If found return
  48.      pointer to the location of the Method's reference in the
  49.      DMT.  If not found, return a nil pointer.                        }
  50.     function  FindDMTMethod (AMethod:pointer; DMTofs:word):pointer;
  51.         var
  52.             DMT:PDMT;
  53.             Table:PMethodTable;
  54.             i:word;
  55.         begin
  56.         DMT := ptr(DSeg,DMTofs);
  57.         Table := ptr(Dseg,DMTofs+8+(DMT^.cnt*2));
  58.         i:=0;
  59.         while (Table^[i]<>AMethod)and(I<(DMT^.cnt-1)) do inc(i);
  60.         if Table^[i]=AMethod then
  61.             FindDMTMethod := @Table^[i]
  62.         else
  63.             if (DMT^.BaseDMT>0) then
  64.                 FindDMTMethod := FindDMTMethod(AMethod,DMT^.BaseDMT)
  65.             else
  66.                 FindDMTMethod := nil;
  67.         end;
  68.  {$ENDIF}
  69.  {------------------------------------------------------}
  70.     {Find a Method in a Virtual Method Table (VMT).  If found return
  71.      pointer to the location of the Method's reference in the
  72.      VMT.  If not found, return a nil pointer.                        }
  73.     function  FindMethodSlot (AMethod:pointer; ClassVMT:pointer):pointer;
  74.         var
  75.             VMT: PVMT absolute ClassVmt;
  76.             Slot: word;
  77.         begin
  78.     { Returns a pointer to AMethod's location in the VMT Table }
  79.         if ValidVMT(VMT) then
  80.             With VMT^ do
  81.                 begin
  82.                 Slot:=0;
  83.                 while (Slot<MaxVMTPointers)and(Table[Slot]<>AMethod) do inc(Slot);
  84.                 if Slot<MaxVMTPointers then
  85.                     FindMethodSlot:= @Table[Slot]
  86.                 else
  87.                  {$IFDEF VER70}
  88.                     if DMTofs >0 then
  89.                         FindMethodSlot := FindDMTMethod(AMethod,DMTofs)
  90.                     else
  91.                  {$ENDIF}
  92.                         FindMethodSlot := nil;
  93.                 end;
  94.         end;
  95.  {---------------------------------------------------------}
  96.     function ReplaceMethod(ClassVMT,OldMethod,NewMethod:pointer):boolean;
  97.         var
  98.             P: ^Pointer;
  99.     { Find OldMethod in VMT/DMT and Replace it with NewMethod }
  100.         begin
  101.         P := FindMethodSlot(OldMethod,ClassVmt);
  102.         if P<>nil then
  103.              begin
  104.              P^ := NewMethod;
  105.              ReplaceMethod := true;
  106.              end
  107.         else
  108.             ReplaceMethod := false;
  109.         end;
  110.  
  111. end.